home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / Oberon⁄F™ 1.1 / Obx / Mod / Twins (.txt) < prev    next >
Encoding:
Oberon Document  |  1996-01-05  |  9.0 KB  |  254 lines  |  [oODC/obnF]
  1. Documents.StdDocumentDesc
  2. Documents.DocumentDesc
  3. Containers.ViewDesc
  4. Views.ViewDesc
  5. Stores.StoreDesc
  6. Documents.ModelDesc
  7. Containers.ModelDesc
  8. Models.ModelDesc
  9. Stores.ElemDesc
  10. TextViews.StdViewDesc
  11. TextViews.ViewDesc
  12. TextModels.StdModelDesc
  13. TextModels.ModelDesc
  14. TextModels.AttributesDesc
  15. Geneva
  16. Geneva
  17. Geneva
  18. MODULE ObxTwins;
  19.     IMPORT Domains, Ports, Stores, Models, Views, Controllers, Properties, TextViews;
  20.     CONST
  21.         minVersion = 1; maxVersion = 1;    (* old version 0 ObxTwin views cannot be read anymore *)
  22.         border = 2 * Ports.mm;
  23.         initContents = FALSE; copyContents = TRUE;
  24.     TYPE
  25.         Context = POINTER TO ContextDesc;
  26.         ContextDesc = RECORD (Models.ContextDesc)
  27.             view: Views.View;    (* contained view *)
  28.             w, h: LONGINT;    (* size of contained view *)
  29.             domain: Domains.Domain    (* domain of container model *)
  30.         END;
  31.         Model = POINTER TO ModelDesc;
  32.         ModelDesc = RECORD (Models.ModelDesc)
  33.             width, topHeight, botHeight: LONGINT;
  34.             top, bottom: Context
  35.         END;
  36.         View = POINTER TO ViewDesc;
  37.         ViewDesc = RECORD (Views.ViewDesc)
  38.             model: Model;
  39.             focus: Context    (* current focus; either model.top or model.bottom *)
  40.         END;
  41.     (* Context *)
  42.     PROCEDURE (c: Context) ThisDomain (): Domains.Domain;
  43.     BEGIN
  44.         RETURN c.domain
  45.     END ThisDomain;
  46.     PROCEDURE (c: Context) GetSize (VAR w, h: LONGINT);
  47.     BEGIN
  48.         w := c.w - border;
  49.         h := c.h - border
  50.     END GetSize;
  51.     PROCEDURE (c: Context) Normalize (): BOOLEAN;
  52.     BEGIN
  53.         RETURN TRUE    (* current scroll positions won't be stored, and scrolling isn't undoable *)
  54.     END Normalize;
  55.     PROCEDURE CopyOf (source: Context; copyContents: BOOLEAN): Context;    (* make a deep copy of a context *)
  56.         VAR c: Context; st: Stores.Store; v: Views.View; m, n: Models.Model;
  57.     BEGIN
  58.         NEW(c);
  59.         st := Stores.Clone(source.view); v := st(Views.View);
  60.         m := source.view.ThisModel();
  61.         IF m # NIL THEN
  62.             st := Stores.Clone(m); n := st(Models.Model);
  63.             IF copyContents THEN n.CopyAllFrom(m) ELSE n.InitFrom(m) END;
  64.             v.InitModel(n)
  65.         END;
  66.         v.CopyFrom(source.view);
  67.         c.view := v; c.w := source.w; c.h := source.h; v.InitContext(c);
  68.         RETURN c
  69.     END CopyOf;
  70.     PROCEDURE InitDomain (c: Context; d: Domains.Domain);
  71.     BEGIN
  72.         c.domain := d; c.view.InitDomain(d)
  73.     END InitDomain;
  74.     PROCEDURE NewContext (v: Views.View; w, h: LONGINT): Context;
  75.         VAR c: Context;
  76.     BEGIN
  77.         NEW(c);
  78.         c.view := v; c.w := w; c.h := h; v.InitContext(c);
  79.         RETURN c
  80.     END NewContext;
  81.     (* Model *)
  82.     PROCEDURE (m: Model) Internalize (VAR rd: Stores.Reader);
  83.         VAR thisVersion: SHORTINT; v: Views.View;
  84.     BEGIN
  85.         m.Internalize^(rd);
  86.         IF ~rd.cancelled THEN
  87.             rd.ReadVersion(minVersion, maxVersion, thisVersion);
  88.             IF~ rd.cancelled THEN
  89.                 rd.ReadLInt(m.width);
  90.                 rd.ReadLInt(m.topHeight);
  91.                 rd.ReadLInt(m.botHeight);
  92.                 Views.ReadView(rd, v); m.top := NewContext(v, m.width, m.topHeight);
  93.                 Views.ReadView(rd, v); m.bottom := NewContext(v, m.width, m.botHeight)
  94.             END
  95.         END
  96.     END Internalize;
  97.     PROCEDURE (m: Model) Externalize (VAR wr: Stores.Writer);
  98.     BEGIN
  99.         m.Externalize^(wr);
  100.         wr.WriteVersion(maxVersion);
  101.         wr.WriteLInt(m.width);
  102.         wr.WriteLInt(m.topHeight);
  103.         wr.WriteLInt(m.botHeight);
  104.         Views.WriteView(wr, m.top.view);
  105.         Views.WriteView(wr, m.bottom.view)
  106.     END Externalize;
  107.     PROCEDURE (m: Model) CopyAllFrom (source: Models.Model);
  108.     BEGIN
  109.         WITH source: Model DO
  110.             m.width := source.width;
  111.             m.topHeight := source.topHeight;
  112.             m.botHeight := source.botHeight;
  113.             m.top := CopyOf(source.top, copyContents);
  114.             m.bottom := CopyOf(source.bottom, copyContents)
  115.         END
  116.     END CopyAllFrom;
  117.     PROCEDURE (m: Model) InitFrom (source: Models.Model);
  118.     BEGIN
  119.         WITH source: Model DO
  120.             m.width := source.width;
  121.             m.topHeight := source.topHeight;
  122.             m.botHeight := source.botHeight;
  123.             m.top := CopyOf(source.top, initContents);
  124.             m.bottom := CopyOf(source.bottom, initContents)
  125.         END
  126.     END InitFrom;
  127.     PROCEDURE (m: Model) InitDomain (d: Domains.Domain);
  128.     BEGIN
  129.         m.InitDomain^(d);
  130.         InitDomain(m.top, d);
  131.         InitDomain(m.bottom, d)
  132.     END InitDomain;
  133.     (* View *)
  134.     PROCEDURE (v: View) InitModel (m: Models.Model);
  135.     BEGIN
  136.         ASSERT((v.model = NIL) OR (m = v.model), 20);
  137.         ASSERT(m # NIL, 21); ASSERT(m IS Model, 23);
  138.         v.model := m(Model);
  139.         v.focus := v.model.bottom
  140.     END InitModel;
  141.     PROCEDURE (v: View) ThisModel (): Model;
  142.     BEGIN
  143.         RETURN v.model
  144.     END ThisModel;
  145.     PROCEDURE (v: View) Internalize (VAR rd: Stores.Reader);
  146.         VAR thisVersion: SHORTINT; s: Stores.Store;
  147.     BEGIN
  148.         v.Internalize^(rd);
  149.         IF ~rd.cancelled THEN
  150.             rd.ReadVersion(minVersion, maxVersion, thisVersion);
  151.             IF ~rd.cancelled THEN
  152.                 rd.ReadStore(s); ASSERT(s # NIL, 100);
  153.                 v.InitModel(s(Model))
  154.             END
  155.         END
  156.     END Internalize;
  157.     PROCEDURE (v: View) Externalize (VAR wr: Stores.Writer);
  158.     BEGIN
  159.         v.Externalize^(wr);
  160.         wr.WriteVersion(maxVersion);
  161.         wr.WriteStore(v.model)
  162.     END Externalize;
  163.     PROCEDURE (v: View) Restore (f: Views.Frame; l, t, r, b: LONGINT);
  164.         VAR m: Model; w: Views.View;
  165.     BEGIN
  166.         m := v.model;
  167.         f.DrawLine(0, m.topHeight, m.width, m.topHeight, f.dot, Ports.black);
  168.         (* install the subframes for the subviews *)
  169.         w := m.top.view; Views.InstallFrame(f, w, Ports.mm, Ports.mm, 0, v.focus.view = w);
  170.         w := m.bottom.view; Views.InstallFrame(f, w, Ports.mm, Ports.mm + m.topHeight, 1, v.focus.view = w)
  171.     END Restore;
  172.     PROCEDURE SetFocus (v: Views.View; x, y: LONGINT): BOOLEAN;
  173.         VAR p: Properties.FocusPref;
  174.     BEGIN    (* determine whether v should be focused when the mouse is clicked at (x, y) in v *)
  175.         p.hotFocus := FALSE;
  176.         p.atLocation := TRUE; p.x := x; p.y := y;
  177.         p.setFocus := FALSE; p.selectOnFocus := FALSE;
  178.         v.HandlePropMsg(p);
  179.         RETURN p.setFocus
  180.     END SetFocus;
  181.     PROCEDURE (v: View) HandleCtrlMsg (f: Views.Frame; VAR msg: Views.CtrlMessage;
  182.                                                             VAR focus: Views.View);
  183.         VAR g: Views.Frame; m: Model; newFocus: Context; mMsg: Controllers.MarkMsg;
  184.     BEGIN
  185.         m := v.model;
  186.         WITH msg: Controllers.CursorMessage DO
  187.             IF msg.y >= m.topHeight THEN newFocus := m.bottom ELSE newFocus := m.top END;
  188.             focus := newFocus.view;
  189.             IF (newFocus # v.focus) & ((msg IS Controllers.TrackMsg) OR (msg IS Controllers.DropMsg)) &
  190.                 SetFocus(focus, msg.x, msg.y) THEN
  191.                 (* remove marks in old focus *)
  192.                 mMsg.show := FALSE;
  193.                 g := Views.ThisFrame(f, v.focus.view); IF g # NIL THEN Views.ForwardCtrlMsg(g, mMsg) END;
  194.                 v.focus := newFocus;    (* set new focus *)
  195.                 (* set marks in new focus *)
  196.                 mMsg.show := TRUE;
  197.                 g := Views.ThisFrame(f, v.focus.view); IF g # NIL THEN Views.ForwardCtrlMsg(g, mMsg) END
  198.             END
  199.         (* the following scrolling-oriented messages are always sent to bottom view, independent of focus *)
  200.         | msg: Controllers.PollSectionMsg DO
  201.             focus := m.bottom.view
  202.         | msg: Controllers.ScrollMsg DO
  203.             focus := m.bottom.view
  204.         | msg: Controllers.PageMsg DO
  205.             focus := m.bottom.view
  206.         ELSE    (* all other messages are sent to the focus, however *)
  207.             focus := v.focus.view
  208.         END
  209.         (* the assignment to focus signals that the view v wants to forward the message to the
  210.         corresponding embedded view *)
  211.     END HandleCtrlMsg;
  212.     PROCEDURE (v: View) HandlePropMsg (VAR msg: Views.PropMessage);
  213.     BEGIN
  214.         WITH msg: Properties.SizePref DO
  215.             msg.w := v.model.width; msg.h := v.model.topHeight + v.model.botHeight
  216.         | msg: Properties.ResizePref DO
  217.             msg.fixed := TRUE
  218.         ELSE
  219.             Views.HandlePropMsg(v.model.bottom.view, msg)
  220.         END
  221.     END HandlePropMsg;
  222.     PROCEDURE NewTwin* (width, topHeight, botHeight: LONGINT; top, bottom: Views.View): Views.View;
  223.         VAR m: Model; v: View;
  224.     BEGIN
  225.         NEW(m);
  226.         m.width := width; m.topHeight := topHeight; m.botHeight := botHeight;
  227.         m.top := NewContext(top, width, topHeight);
  228.         m.bottom := NewContext(bottom, width, botHeight);
  229.         NEW(v); v.InitModel(m);
  230.         RETURN v
  231.     END NewTwin;
  232.     (* example twin view with two embedded text views *)
  233.     PROCEDURE New* (): Views.View;
  234.         CONST width =  160 * Ports.mm; topHeight = 30 * Ports.mm; botHeight = 500 * Ports.mm;
  235.     BEGIN
  236.         RETURN NewTwin(width, topHeight, botHeight,TextViews.dir.StdNew(), TextViews.dir.StdNew())
  237.     END New;
  238.     PROCEDURE Deposit*;
  239.     BEGIN
  240.         Views.Deposit(New())
  241.     END Deposit;
  242. END ObxTwins.
  243. TextControllers.StdCtrlDesc
  244. TextControllers.ControllerDesc
  245. Containers.ControllerDesc
  246. Controllers.ControllerDesc
  247. TextRulers.StdRulerDesc
  248. TextRulers.RulerDesc
  249. TextRulers.StdStyleDesc
  250. TextRulers.StyleDesc
  251. TextRulers.AttributesDesc
  252. Arial
  253. Documents.ControllerDesc
  254.